home *** CD-ROM | disk | FTP | other *** search
/ World of Education / World of Education.iso / world_s / sp12src.zip / TOKEN.PAS < prev    next >
Pascal/Delphi Source File  |  1990-12-18  |  13KB  |  424 lines
  1. {$A+,B-,D-,E-,F+,I+,L-,N-,O-,R-,S-,V-}
  2. Unit Token;
  3. Interface
  4. Uses Objects;
  5.  
  6. Const
  7.   TokenStringSize = 35;      { Maximum size of a string to be tokenized }
  8.   TokenEntryListSize = 20;   { Number of tokens per hash entry block }
  9.   HashTableSize = 211;       { Size of hash table }
  10.  
  11. Type
  12.   TokenStringPtr = ^TokenString;
  13.   TokenString = String[TokenStringSize];
  14.  
  15.   TokenTextTablePtr = ^TokenTextTableType;
  16.   TokenTextTableType = Record
  17.     TokenTextEntry : Array[0..255] Of TokenStringPtr; { Index by Lo(Token) }
  18.   End;
  19.  
  20.   HashEntryPtr = ^HashEntryType;
  21.   HashEntryType = Record
  22.   { An array of tokens of strings all hashing to the same value }
  23.     EntChain : HashEntryPtr; { Blocks chained onto TokTable }
  24.     EntTokenCount : Word;    { Number of tokens in this block }
  25.     EntToken : Array[1..TokenEntryListSize] Of Word;
  26.   End;
  27.  
  28.   PToken = ^TToken;
  29.   TToken = Object(TObject)
  30.     TokMaxToken : Word;      { Maximum current token }
  31.  
  32.     Constructor Init;
  33.     { Initialize hash table }
  34.  
  35.     Constructor RestoreHashTable(FileName : String);
  36.     { Restore hash table from named file }
  37.  
  38.     Function TokenText(Token : Word) : TokenString;
  39.     { Return text given token, or null string if token not in table. }
  40.  
  41.     Function TokenInsertText(St : TokenString) : Word;
  42.     { Enter string in hash table if not duplicate; return token }
  43.  
  44.     Procedure TokenUpdateText(Token : Word; St : TokenString);
  45.     { Update the text associated with a token }
  46.  
  47.     Function TextToken(St : TokenString) : Word;
  48.     { Locate text in hash table; return token, or 0 if not found }
  49.  
  50.     Function TokenAddress(Token : Word) : TokenStringPtr;
  51.     { Return address of string represented by Token (no checking) }
  52.  
  53.     Procedure SaveHashTable(FileName : String);
  54.     { Save hash table to named file }
  55.  
  56.     Destructor Done; Virtual;
  57.     { Releases all storage associated with hash table }
  58.  
  59.     Procedure EditMatch(Count : Byte; Var MatchTable;
  60.       St : TokenString; TotalMatch : Boolean);
  61.     { Return a set of tokens of strings that most nearly match string St as
  62.       determined by EditDistance.  Count specifies the maximum number of
  63.       tokens to be returned.  MatchTable is an array of at least Count
  64.       words.  Tokens are returned in order of smallest to largest
  65.       EditDistance.  If TotalMatch is TRUE, all words are examined;
  66.       otherwise only words beginning with the same first letter as St are
  67.       examined (saves time). }
  68.  
  69.     Function HashListLength(Bucket : Word) : Word;
  70.     { Return the number of entries in the indicated hash bucket entry chain. This
  71.       function is for performance analysis purposes only }
  72.  
  73.     Private
  74.  
  75.     TokTextTable : Array[0..255] Of TokenTextTablePtr; { Index by Hi(Token) }
  76.     TokHashTable : Array[0..HashTableSize-1] Of HashEntryPtr;
  77.  
  78.     Procedure InsertHashEntry(Token, Hash : Word);
  79.     { Insert Token in hash table chain }
  80.  
  81.     Procedure InsertTextEntry(Token : Word; Var St : TokenString);
  82.     { Insert word string in word table }
  83.  
  84.     Function LocateString(Var St : TokenString; Hash : Word) : Word;
  85.     { Locate text in hash table; return token, or 0 if not found }
  86.   End;
  87.  
  88. Implementation
  89. Uses EditDist, PairHeap;
  90. Const
  91.   TextBufSize = 16384;       { Size of text buffer for Save/Restore }
  92.   SaveMagicNumber = $EF120550; { Magic number for save/restore }
  93.  
  94. Type
  95.   MatchRecordPtr = ^MatchRecord;
  96.   MatchRecord = Object(HeapEntry)
  97.   { Used by EditMatch to sort tokens }
  98.     Token : Word;
  99.     Distance : Word;
  100.   End;
  101.  
  102.   HeapControl = Object(TopSoMany)
  103.     Function Less(Var x, y : HeapEntry) : Boolean; Virtual;
  104.   End;
  105.  
  106. Function HashPJW(Var s : TokenString) : Word;
  107. { Hash string to a number between 0 and HashTableSize-1 }
  108.   Function HashPJWPrim(Var s : TokenString) : LongInt;
  109.   Inline(
  110.     $5E/                   {    pop    si}
  111.     $58/                   {    pop    ax}
  112.     $1E/                   {    push   ds}
  113.     $8E/$D8/               {    mov    ds,ax}
  114.     $31/$DB/               {    xor    bx,bx}
  115.     $31/$D2/               {    xor    dx,dx}
  116.     $AC/                   {    lodsb}
  117.     $30/$E4/               {    xor    ah,ah}
  118.     $89/$C1/               {    mov    cx,ax}
  119.     $E3/$2C/               {    jcxz   done}
  120.                            {next:}
  121.     $D1/$E3/               {    shl    bx,1}
  122.     $D1/$D2/               {    rcl    dx,1}
  123.     $D1/$E3/               {    shl    bx,1}
  124.     $D1/$D2/               {    rcl    dx,1}
  125.     $D1/$E3/               {    shl    bx,1}
  126.     $D1/$D2/               {    rcl    dx,1}
  127.     $D1/$E3/               {    shl    bx,1}
  128.     $D1/$D2/               {    rcl    dx,1}
  129.     $AC/                   {    lodsb}
  130.     $01/$C3/               {    add    bx,ax}
  131.     $83/$D2/$00/           {    adc    dx,0}
  132.     $F6/$C6/$F0/           {    test   dh,$F0}
  133.     $74/$0F/               {    jz     skip}
  134.     $88/$F0/               {    mov    al,dh}
  135.     $80/$E6/$0F/           {    and    dh,$0F}
  136.     $D0/$E8/               {    shr    al,1}
  137.     $D0/$E8/               {    shr    al,1}
  138.     $D0/$E8/               {    shr    al,1}
  139.     $D0/$E8/               {    shr    al,1}
  140.     $30/$C3/               {    xor    bl,al}
  141.                            {skip:}
  142.     $E2/$D4/               {    loop   next}
  143.                            {done:}
  144.     $1F/                   {    pop    ds}
  145.     $89/$D8);              {    mov    ax,bx}
  146. Begin
  147.   HashPJW := HashPJWPrim(s) Mod HashTableSize;
  148. End;
  149.  
  150. Constructor TToken.Init;
  151. { Initialize control pointers }
  152. Begin
  153.   If Not TObject.Init Then Fail;
  154.   TokMaxToken := 0;
  155.   FillChar(TokTextTable, SizeOf(TokTextTable), 0);
  156.   FillChar(TokHashTable, SizeOf(TokHashTable), 0);
  157. End;
  158.  
  159. Procedure TToken.InsertHashEntry(Token, Hash : Word);
  160. Var
  161.   Entry : HashEntryPtr;
  162. Begin
  163.   Entry := TokHashTable[Hash];
  164.   If (Entry = Nil) Or (Entry^.EntTokenCount >= TokenEntryListSize) Then
  165.   Begin
  166.     New(Entry);
  167.     If Entry <> Nil Then With Entry^ Do Begin
  168.       EntChain := TokHashTable[Hash];
  169.       EntTokenCount := 0;
  170.       TokHashTable[Hash] := Entry;
  171.     End;
  172.   End;
  173.   If Entry <> Nil Then With Entry^ Do Begin
  174.     Inc(EntTokenCount);
  175.     EntToken[EntTokenCount] := Token;
  176.   End;
  177. End;
  178.  
  179. Procedure TToken.InsertTextEntry(Token : Word; Var St : TokenString);
  180. { Insert word string in word table }
  181. Var
  182.   j : Word;
  183. Begin
  184.   j := Hi(Token);
  185.   If TokTextTable[j] = Nil Then Begin
  186.     New(TokTextTable[j]);
  187.     If TokTextTable[j] <> Nil Then With TokTextTable[j]^ Do Begin
  188.       FillChar(TokenTextEntry, SizeOf(TokenTextEntry), 0);
  189.     End;
  190.   End;
  191.   If TokTextTable[j] <> Nil Then With TokTextTable[j]^ Do Begin
  192.     j := Lo(Token);
  193.     If TokenTextEntry[j] <> Nil Then
  194.       FreeMem(TokenTextEntry[j], Succ(Length(TokenTextEntry[j]^)));
  195.     GetMem(TokenTextEntry[j], Succ(Length(St)));
  196.     If TokenTextEntry[j] <> Nil Then TokenTextEntry[j]^ := St;
  197.   End;
  198. End;
  199.  
  200. Function TToken.LocateString(Var St : TokenString; Hash : Word) : Word;
  201. { Locate text in hash table; return token, or 0 if not found }
  202. Var
  203.   Entry, Trail : HashEntryPtr;
  204.   i, Token : Word;
  205.   Found : Boolean;
  206. Begin
  207.   LocateString := 0;
  208.   Entry := TokHashTable[Hash];
  209.   Trail := Nil;
  210.   Found := False;
  211.   While Entry <> Nil Do With Entry^ Do Begin
  212.     i := 1;
  213.     Repeat
  214.       Token := EntToken[i];
  215.       Inc(i);
  216.       Found := TokTextTable[Hi(Token)]^.TokenTextEntry[Lo(Token)]^ = St;
  217.     Until Found Or (i > EntTokenCount);
  218.     If Found Then Begin
  219.       LocateString := Token;
  220.       Dec(i, 2);
  221.       If i > 0 Then Begin
  222.         EntToken[Succ(i)] := EntToken[i];
  223.         EntToken[i] := Token;
  224.       End Else If Trail <> Nil Then Begin
  225.         i := Trail^.EntTokenCount;
  226.         EntToken[1] := Trail^.EntToken[i];
  227.         Trail^.EntToken[i] := Token;
  228.       End;
  229.       Entry := Nil;
  230.     End Else Begin
  231.       Trail := Entry;
  232.       Entry := EntChain;
  233.     End;
  234.   End;
  235. End;
  236.  
  237. Function TToken.TokenText(Token : Word) : TokenString;
  238. Begin
  239.   TokenText := '';
  240.   If TokTextTable[Hi(Token)] <> Nil Then With TokTextTable[Hi(Token)]^ Do
  241.     If TokenTextEntry[Lo(Token)] <> Nil Then
  242.       TokenText := TokenTextEntry[Lo(Token)]^
  243. End;
  244.  
  245. Function TToken.TokenInsertText(St : TokenString) : Word;
  246. Var
  247.   h, j : Word;
  248. Begin
  249.   h := HashPJW(St);
  250.   j := LocateString(St, h);
  251.   If j = 0 Then Begin
  252.     If TokMaxToken < $FFFF Then Begin
  253.       Inc(TokMaxToken);
  254.       j := TokMaxToken;
  255.       InsertTextEntry(j, St);
  256.       InsertHashEntry(j, h);
  257.     End;
  258.   End;
  259.   TokenInsertText := j;
  260. End;
  261.  
  262. Procedure TToken.TokenUpdateText(Token : Word; St : TokenString);
  263. Var
  264.   h : Word;
  265. Begin
  266.   InsertTextEntry(Token, St);
  267.   h := HashPJW(St);
  268.   If LocateString(St, h) = 0 Then
  269.     InsertHashEntry(Token, h);
  270.   If TokMaxToken < Token Then TokMaxToken := Token;
  271. End;
  272.  
  273. Function TToken.TextToken(St : TokenString) : Word;
  274. Begin
  275.   TextToken := LocateString(St, HashPJW(St));
  276. End;
  277.  
  278. Function TToken.TokenAddress(Token : Word) : TokenStringPtr;
  279. Begin
  280.   TokenAddress := TokTextTable[Hi(Token)]^.TokenTextEntry[Lo(Token)];
  281. End;
  282.  
  283. Procedure TToken.SaveHashTable(FileName : String);
  284. Type
  285.   TextBuffer = Array[1..TextBufSize] Of Char;
  286. Var
  287.   Buf : ^TextBuffer;
  288.   f : Text;
  289.   i : Word;
  290. Begin
  291.   Assign(f, FileName);
  292.   New(Buf);
  293.   If Buf <> Nil Then SetTextBuf(f, Buf^, TextBufSize);
  294.   ReWrite(f);
  295.   WriteLn(f, SaveMagicNumber);
  296.   For i := 1 To TokMaxToken Do
  297.     WriteLn(f, TokenAddress(i)^);
  298.   Close(f);
  299.   Dispose(Buf);
  300. End;
  301.  
  302. Constructor TToken.RestoreHashTable(FileName : String);
  303. Type
  304.   TextBuffer = Array[1..TextBufSize] Of Char;
  305. Var
  306.   Buf : ^TextBuffer;
  307.   n : LongInt;
  308.   i : Word;
  309.   f : Text;
  310.   st : TokenString;
  311.   ch : Char;
  312. Begin
  313.   TokMaxToken := 0;
  314.   FillChar(TokTextTable, SizeOf(TokTextTable), 0);
  315.   FillChar(TokHashTable, SizeOf(TokHashTable), 0);
  316.   {$I-}
  317.   Assign(f, FileName);
  318.   New(Buf);
  319.   If Buf <> Nil Then SetTextBuf(f, Buf^, TextBufSize);
  320.   Reset(f);
  321.   {$I+}
  322.   If IoResult = 0 Then Begin
  323.     ReadLn(f, n);
  324.     If n = SaveMagicNumber Then Begin
  325.       i := 1;
  326.       While Not Eof(f) Do Begin
  327.         ReadLn(f, st);
  328.         TokenUpdateText(i, st);
  329.         Inc(i);
  330.       End;
  331.     End;
  332.     Close(f);
  333.   End;
  334.   Dispose(Buf);
  335. End;
  336.  
  337. Destructor TToken.Done;
  338. Var
  339.   i, j : Byte;
  340.   Entry, Temp : HashEntryPtr;
  341. Begin
  342.   For i := 0 To 255 Do If TokTextTable[i] <> Nil Then
  343.   With TokTextTable[i]^ Do Begin
  344.     For j := 0 To 255 Do If TokenTextEntry[j] <> Nil Then
  345.       FreeMem(TokenTextEntry[j], Succ(Length(TokenTextEntry[j]^)));
  346.     Dispose(TokTextTable[i]);
  347.   End;
  348.   For i := 0 To Pred(HashTableSize) Do Begin
  349.     Entry := TokHashTable[i];
  350.     While Entry <> Nil Do Begin
  351.       Temp := Entry^.EntChain;
  352.       Dispose(Entry);
  353.       Entry := Temp;
  354.     End;
  355.   End;
  356. End;
  357.  
  358. Function HeapControl.Less(Var x, y : HeapEntry) : Boolean;
  359. Var
  360.   xx : MatchRecord Absolute x;
  361.   yy : MatchRecord Absolute y;
  362. Begin
  363.   Less := xx.Distance > yy.Distance;
  364. End;
  365.  
  366. Procedure TToken.EditMatch(Count : Byte; Var MatchTable;
  367.   St : TokenString; TotalMatch : Boolean);
  368. Var
  369.   Heap : HeapControl;
  370.   Rec : MatchRecordPtr;
  371.   i, j, Dist : Word;
  372.   Match : Array[1..255] Of Word Absolute MatchTable;
  373. Begin
  374.   Heap.Init(Count);
  375.   With Heap Do Begin
  376.     For i := 1 To TokMaxToken Do Begin
  377.       If TotalMatch
  378.       Or (TokTextTable[Hi(i)]^.TokenTextEntry[Lo(i)]^[1] = St[1])
  379.       Or (TokTextTable[Hi(i)]^.TokenTextEntry[Lo(i)]^[1] = St[2])
  380.       Then Begin
  381.         Dist := EditDistance(St,
  382.           TokTextTable[Hi(i)]^.TokenTextEntry[Lo(i)]^);
  383.         Rec := GetDiscard;
  384.         If Rec = Nil Then New(Rec);
  385.         If Rec <> Nil Then Begin
  386.           With Rec^ Do Begin
  387.             Token := i;
  388.             Distance := Dist;
  389.           End;
  390.           Insert(Rec^);
  391.         End;
  392.       End;
  393.     End;
  394.     Repeat
  395.       Rec := GetDiscard;
  396.       If Rec <> Nil Then Dispose(Rec);
  397.     Until Rec = Nil;
  398.     j := EntryCount;
  399.   End;
  400.   For i := Count DownTo 1 Do If i > j Then Match[i] := 0 Else Begin
  401.     Rec := Heap.DeleteLowEntry;
  402.     Match[i] := Rec^.Token;
  403.     Dispose(Rec);
  404.   End;
  405. End;
  406.  
  407. Function TToken.HashListLength(Bucket : Word) : Word;
  408. Var
  409.   Count : Word;
  410.   Entry : HashEntryPtr;
  411. Begin
  412.   HashListLength := 0;
  413.   If Bucket < HashTableSize Then Begin
  414.     Count := 0;
  415.     Entry := TokHashTable[Bucket];
  416.     While Entry <> Nil Do With Entry^ Do Begin
  417.       Inc(Count, EntTokenCount);
  418.       Entry := EntChain;
  419.     End;
  420.     HashListLength := Count;
  421.   End;
  422. End;
  423.  
  424. End.